1 Example Trial

prior <- c(0.1, 0.2, 0.3)
target <- 0.2
obswin <- 56

Consider a trial with:

  • 3 dose levels
  • A target DLT rate of 20% (TD20)
  • Prior guess of TD20 at dose level 2
  • Follow up period of 8 weeks (56 days)
  • Patients starting at dose level 1
  • A linear weighting
  • TITE-CRM using the empiric model

2 Simple Case

The simplest case would involve just a single patient. There are two possible outcomes:

  • Toxicity (T)
  • No toxicity (N)

2.1 If Toxicity Occurs

If a toxicity occurs, the time it happens is irrelevent as the weighting is automatically set at 1,

level <- 1 
tox <- 1
followup <- 56 

mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
               obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today:  Wed Jun 23 11:18:58 2021 
## DATA SUMMARY (TITE-CRM) 
## PID   Level   Toxicity    f/u     Weight      Included 
## 1     1   1       56      1       1 
## 
## Toxicity probability update (with 90 percent probability interval): 
## Level     Prior   n   total.wts   total.tox   Ptox    LoLmt   UpLmt 
## 1     0.1     1   1       1       0.507   0.078   0.835 
## 2     0.2     0   0       0       0.622   0.168   0.882 
## 3     0.3     0   0       0       0.701   0.263   0.91 
## Next recommended dose level: 1 
## Recommendation is based on a target toxicity probability of 0.2 
## 
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3 
## Normal prior on beta with mean 0 and variance 1.34 
## Posterior mean of beta: -1.222 
## Posterior variance of beta: 0.65

The reccommended dose is dose level 1.

2.2 If No Toxicity Occurs

If no toxicity is observed the next dose allocated would depend on the follow up of the patient. Here there would be 56 different possibilities. The patient could be followed up for either \(1, 2, 3, ..., 56\) days.

tox <- 0 
followup <- 1:obswin
results <- data.frame('Observed' = followup, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
  followup <- i 
  mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
                    obswin = obswin, scheme = 'linear', followup = followup)
  results$Rec[i] <- mod$mtd
}

We can determine the next dose by looping through all possible values of follow up. The results can be summarised using the min and max follow up days for each dose.

results <- results %>% group_by('Next Dose' = Rec) %>% 
  summarise('Follow up data' = paste(min(Observed), max(Observed), 
                                     sep ='-'))
kable(results, align = 'cc') %>% 
 kable_styling(full_width = F, position = 'left')
Next Dose Follow up data
2 1-30
3 31-56

This can be interpreted as the next dose will be 2 if the previous patien has no toxicity and has been observed between 1 and 30 days. Likewise, the next dose level would be 3 if no toxicities were observed between days 31 and 56.

2.3 DTP for 1 Patient

kable(results %>% 
  pivot_wider(names_from = `Next Dose`, values_from = `Follow up data` ) %>%   mutate(Outcome = c('N'), `1` = '-') %>% 
  select(Outcome, `1`, `2`, `3`) %>% 
  rbind(c('T', 'Always', '-', '-' )) %>% 
  arrange(`2`), align = 'lccc') %>% 
  kable_styling(full_width = F, position = 'left') %>% 
  add_header_above(c(" " = 1, "Recommended Dose" = 3))
Recommended Dose
Outcome 1 2 3
T Always
N
1-30 31-56
Putting this all together gives the table above. The numbers represent the amount of follow up which would need to be observed. I just forced this together as a proof of concept. I’m not 100% sure how this should be summarised.

3 Case of 2 Patients or Cohorts of 2

Calculating the next pathway becomes more tricky depending on the outcome. It is somewhat similar to having a cohort of 2 patients. In both these cases the possible outcomes are:

  • TT
  • NT (note NT and TN are the same)
  • NN

As before the TT case is quite simple to solve as the weights/follow-up are set at 1. Similarly NT can be summarised in a similar way as above except when we run the CRM there will be an extra patient with a toxicity.

3.1 If TT Occurs

level <- c(1,1)
tox <- c(1,1)
followup <- c(56,56)

mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
               obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today:  Wed Jun 23 11:18:58 2021 
## DATA SUMMARY (TITE-CRM) 
## PID   Level   Toxicity    f/u     Weight      Included 
## 1     1   1       56      1       1 
## 2     1   1       56      1       1 
## 
## Toxicity probability update (with 90 percent probability interval): 
## Level     Prior   n   total.wts   total.tox   Ptox    LoLmt   UpLmt 
## 1     0.1     2   2       2       0.629   0.205   0.873 
## 2     0.2     0   0       0       0.723   0.33    0.91 
## 3     0.3     0   0       0       0.785   0.436   0.932 
## Next recommended dose level: 1 
## Recommendation is based on a target toxicity probability of 0.2 
## 
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3 
## Normal prior on beta with mean 0 and variance 1.34 
## Posterior mean of beta: -1.603 
## Posterior variance of beta: 0.559

The reccommended dose is dose level 1.

3.2 If NT Occurs

level <- c(1,1)
tox <- c(1,0)
followupcombo <- cbind(rep(56, obswin), 1:56)
results <- data.frame('Observed' = 1:56, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
  followup <- followupcombo[i,]
  mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
                 obswin = obswin, scheme = 'linear', followup = followup)
  results$Rec[i] <- mod$mtd
}

kable(results %>% group_by(TD20 = Rec) %>% 
  summarise(n = n()), align = 'cc') %>% 
  kable_styling(full_width = F, position = 'left')
TD20 n
1 56

The recommended dose is 1 no matter how much observed data there is for the patient with no toxicity.

3.3 If NN Occurs

Here there are 3136 variations of the NN outcome. The number of variations is \((observation \; period)^ {No. \;Patients}\). We could observe both patiens for 1 day each or both for the whole window and everything inbetween.

level <- c(1,1)
tox <- c(0,0)
combos <- 1:obswin
combos <- expand.grid(combos, combos)
pos <- cbind(rep(0,nrow(combos)))
results <-  pos[, rep(1, each=length(tox)+1)]
for (i in 1:nrow(combos)) {
  followup <- as.numeric(combos[i,])
  weights <- followup / obswin 
  mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
                 obswin = obswin, weights = weights)

  for (j in 1:ncol(results)) {
    results[,j][i] <- followup[j]
    results[,ncol(results)][i] <- mod$mtd
  }
}

results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'TD20')
results

Scrolling through the table you can see that certain combinations of follow up times lead to different reccomendations for the TD.

3.3.1 Summarising using Total Follow-Up

One thought I had was to look at the total follow up of both patients depending on what dose recommendation the TITE-CRM made.

kable(results %>% mutate(TotalFollow = Patient1+Patient2) %>% 
  group_by(TD20) %>% 
  summarise(n = n(), min = min(TotalFollow), max = max(TotalFollow)), 
  align = 'cccc') %>% 
  kable_styling(full_width = F, position = 'left')
TD20 n min max
2 488 2 33
3 2648 31 112

One assumption used here is that both patients will have at least 1 day of follow-up. The table indicates that if the total follow-up time between both patients exceeds 33 the TITE-CRM will recommed dose level 3. Similarly, if total follow-up is less than 30 the model will always recommend dose level 2. However, there is a grey area, if the total follow-up is between 31 and 33 it could recommend either dose.

3.3.2 Visualisation of the problem

results %>% 
  ggplot(aes(x = Patient1, y = Patient2, fill = as.factor(TD20))) +
  geom_tile() +
  scale_fill_brewer(palette = 'Paired') + 
  theme_bw() + 
  geom_abline(intercept = 30, slope = -1, col = 'red', 
              linetype = 'dashed') +
  geom_abline(intercept = 34, slope = -1, col = 'red', 
              linetype = 'dashed') +
  theme(panel.border = element_blank(), panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.line = element_line(colour = "black")) +
  labs(fill = 'TD20', x = 'Patient 1 follow-up',
       y = 'Patient 2 follow-up')+ 
    scale_x_continuous(breaks = seq(0, 60, by = 05), expand = c(0, 0))+
    scale_y_continuous(breaks = seq(0, 60, by = 05), expand = c(0, 0))

I am not sure what is causing this. If the observation window were longer I would assume this becomes a singular straight line.

3.4 Summarising all outcomes

kable(data.frame(Outcomes = c('TT', 'NT', 'NN'),
                `1` = c('Always', 'Always', '-'),
                `2` = c('-', '-', '2-30'),
                `3` = c('-', '-', '34-112'), check.names = FALSE),
      align = 'lccc') %>%
  kable_styling(full_width = F, position = 'left') %>% 
  add_header_above(c(" " = 1, "Recommended Dose" = 3))
Recommended Dose
Outcomes 1 2 3
TT Always
NT Always
NN
2-30 34-112

4 With 3 Patients

Possible outcomes:

  • TTT
  • NTT (56 variations)
  • NNT (3136 variations)
  • NNN (175616 variations)

4.1 TTT, NTT & NNT Outcomes

These are just extensions of the case with two patients except an extra patient has a toxicity.

4.1.1 If TT Occurs

level <- c(1,1,1)
tox <- c(1,1,1)
followup <- c(56,56,56)

mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
               obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today:  Wed Jun 23 11:19:00 2021 
## DATA SUMMARY (TITE-CRM) 
## PID   Level   Toxicity    f/u     Weight      Included 
## 1     1   1       56      1       1 
## 2     1   1       56      1       1 
## 3     1   1       56      1       1 
## 
## Toxicity probability update (with 90 percent probability interval): 
## Level     Prior   n   total.wts   total.tox   Ptox    LoLmt   UpLmt 
## 1     0.1     3   3       3       0.695   0.307   0.894 
## 2     0.2     0   0       0       0.776   0.438   0.925 
## 3     0.3     0   0       0       0.827   0.54    0.943 
## Next recommended dose level: 1 
## Recommendation is based on a target toxicity probability of 0.2 
## 
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3 
## Normal prior on beta with mean 0 and variance 1.34 
## Posterior mean of beta: -1.846 
## Posterior variance of beta: 0.513

The reccommended dose is dose level 1.

4.1.2 If NTT Occurs

level <- c(1,1,1)
tox <- c(0,1,1)
followupcombo <- cbind(1:56, rep(56, obswin), rep(56, obswin))
results <- data.frame('Observed' = 1:56, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
  followup <- followupcombo[i,]
  mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
                 obswin = obswin, scheme = 'linear', followup = followup)
  results$Rec[i] <- mod$mtd
}

kable(results %>% group_by(TD20 = Rec) %>% 
  summarise(n=n()), align = 'cc') %>% 
  kable_styling(full_width = F, position = 'left')
TD20 n
1 56

Similar to before the recommended dose will always be 1 no matter how much data is observed for the patient without a toxicity.

4.1.3 If NNT Occurs

level <- c(1,1,1)
tox <- c(1,0,0)
combos <- 1:obswin
combos <- expand.grid(combos, combos) 
combos <- cbind(56, combos)
pos <- cbind(rep(0,nrow(combos)))
results <-  pos[, rep(1, each=3)]
for (i in 1:nrow(combos)) {
  followup <- as.numeric(combos[i,])
  weights <- followup / obswin 
  mod <- titecrm(prior = prior, target = target, tox = tox, level = level, 
                 obswin = obswin, weights = weights)

  for (j in 1:ncol(results)) {
    results[,j][i] <- followup[j]
    results[,ncol(results)][i] <- mod$mtd
  }
}

results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'TD20')

kable(results %>% group_by(TD20) %>% 
  summarise(n=n()), align = 'cc') %>%
  kable_styling(full_width = F, position = 'left')
TD20 n
1 3136

With one toxicity the model still won’t escalate even if two other patients have been fully observed without tox.

4.2 NNN Outcome

I ran these separately. Took about 1 hour for all iterations.

load('TITE_DTPs_3.RData')
results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'Patient3', 'TD20')
results
kable(results %>%
  mutate(TotalFollow = Patient1+Patient2+Patient3) %>% 
  group_by(TD20) %>% 
  summarise(n = n(), min = min(TotalFollow), max = max(TotalFollow)),
  align = 'cccc') %>% 
  kable_styling(full_width = F, position = 'left')
TD20 n min max
2 5339 3 34
3 170277 31 168

These results can be interpreted similar to the ones before except now the total follow-up is for three patients. So, if the total follow-up is between 3 and 30 the model will definitely recommend dose level 2. If the total follow up is between 35 and 168 the model will definitely recommend dose level 3. If the total follow up is between 31 and 34 it could be either 2 or 3.

4.2.1 Visualisation

Interactive plot. Essentially a 3D version of the plot before. We could define two planes where everything above and below would be a certain dose. My linear algebra is a bit rusty so i’ll pursue this if you think its worth the time.

plot3d(x = results$Patient1, y = results$Patient2, z = results$Patient3,
       col = as.factor(results$TD20), xlab = 'Patient 1 follow-up',
       ylab = 'Patient 2 follow-up', zlab = 'Patient 3 follow-up')

4.3 Summary

kable(data.frame(Outcomes = c('TTT', 'NTT', 'NNT', 'NNN'),
                `1` = c('Always', 'Always', 'Always', '-'),
                `2` = c('-', '-', '-' ,'3-30'),
                `3` = c('-', '-', '-', '35-168'), check.names = FALSE),
      align = 'lccc') %>%
  kable_styling(full_width = F, position = 'left') %>% 
  add_header_above(c(" " = 1, "Recommended Dose" = 3))
Recommended Dose
Outcomes 1 2 3
TTT Always
NTT Always
NNT Always
NNN
3-30 35-168
This would be the DTP for a cohort of 3.

5 Implementation into ADePT-DDR

ADePT is slightly different due to the way in which the follow-up period works. Each patient is observed for a minimum of 8 weeks post treatment which is assigned a weighting of 60%. So the DTP will be based on observed follow-up from 8 weeks till the end of the entire follow-up period (52 weeks). This is 308 days and as we are using cohorts of 3 there is about 29.5 million possible outcomes (this would take about 5-6 days to run). Due to the rules of ADePT we won’t be skipping untried doses. So for the first cohort there is only two options escalate to the dose above or de-escalate to the dose below.

6 Session Info

sessionInfo()
## R version 4.0.3 (2020-10-10)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United Kingdom.1252 
## [2] LC_CTYPE=English_United Kingdom.1252   
## [3] LC_MONETARY=English_United Kingdom.1252
## [4] LC_NUMERIC=C                           
## [5] LC_TIME=English_United Kingdom.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rgl_0.106.8      knitr_1.33       rglwidget_0.2.1  car_3.0-10      
##  [5] carData_3.0-4    kableExtra_1.3.4 ggplot2_3.3.3    tidyr_1.1.3     
##  [9] dplyr_1.0.6      dtpcrm_0.1.1     dfcrm_0.2-2.1   
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.6              svglite_2.0.0           digest_0.6.27          
##  [4] utf8_1.2.1              mime_0.10               R6_2.5.0               
##  [7] cellranger_1.1.0        evaluate_0.14           highr_0.9              
## [10] httr_1.4.2              pillar_1.6.1            rlang_0.4.11           
## [13] curl_4.3.1              readxl_1.3.1            miniUI_0.1.1.1         
## [16] rstudioapi_0.13         data.table_1.14.0       jquerylib_0.1.4        
## [19] rmarkdown_2.8           webshot_0.5.2           stringr_1.4.0          
## [22] foreign_0.8-80          htmlwidgets_1.5.3       munsell_0.5.0          
## [25] shiny_1.6.0             compiler_4.0.3          httpuv_1.6.1           
## [28] xfun_0.23               pkgconfig_2.0.3         systemfonts_1.0.2      
## [31] htmltools_0.5.1.1       tidyselect_1.1.1        tibble_3.1.1           
## [34] rio_0.5.26              fansi_0.4.2             viridisLite_0.4.0      
## [37] crayon_1.4.1            withr_2.4.2             later_1.2.0            
## [40] grid_4.0.3              xtable_1.8-4            jsonlite_1.7.2         
## [43] gtable_0.3.0            lifecycle_1.0.0         magrittr_2.0.1         
## [46] scales_1.1.1            zip_2.1.1               stringi_1.5.3          
## [49] farver_2.1.0            promises_1.2.0.1        xml2_1.3.2             
## [52] bslib_0.2.5.1           ellipsis_0.3.2          generics_0.1.0         
## [55] vctrs_0.3.8             openxlsx_4.2.3          RColorBrewer_1.1-2     
## [58] tools_4.0.3             forcats_0.5.1           manipulateWidget_0.11.0
## [61] glue_1.4.2              purrr_0.3.4             hms_1.1.0              
## [64] crosstalk_1.1.1         fastmap_1.1.0           abind_1.4-5            
## [67] yaml_2.2.1              colorspace_2.0-1        rvest_1.0.0            
## [70] haven_2.4.1             sass_0.4.0